home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Pascal / Snippets / ZoomRecter 1.0 / ZoomRecter.p < prev    next >
Encoding:
Text File  |  1995-05-18  |  4.8 KB  |  213 lines  |  [TEXT/PJMM]
  1. (*}
  2. {    Zoom-Rect-er}
  3. {    DTS Code Snippet}
  4. {    }
  5. {    1/6/92    Steve Falkenburg}
  6. {    }
  7. {    This snippet shows how to do "Finder" style zooming between two rectangles.}
  8. {    The boolean flag "kZoomLarger" controls the proportional direction of the zooming.}
  9. {    }
  10. {    To get the two rectangles, you drag them out rubberbanded, and the zoom occurs between}
  11. {    them.  To quit, click the close box.}
  12. {    }
  13. {    If you want to do zooms between windows, open up a port with the dimensions of the desktop}
  14. {    (from GetGrayRgn()).}
  15. {    }
  16. {    DON'T use this as a sample of how to do rubberband drawing!!!  It's sort of hacked}
  17. {    together bypassing the event mechanism and just using Button().}
  18. {*)
  19.  
  20. program ZoomRecter;
  21.  
  22.     const
  23.         kNumSteps = 14;
  24.         kRectsVisible = 4;
  25.         kZoomRatio = 0.7;
  26.         kDelayTicks = 1;
  27.  
  28.         kZoomLarger = true;{ change this to zoom "inward"}
  29.  
  30.     var
  31.         gDone: Boolean;
  32.  
  33.  
  34.     procedure InitStuff;
  35.     begin
  36. {$IFC UNDEFINED THINK_PASCAL}
  37.         InitGraf(@qd.thePort);
  38. {$ELSEC}
  39.         InitGraf(@thePort);
  40. {$ENDC}
  41.         InitFonts;
  42.         InitWindows;
  43.         InitMenus;
  44.         TEInit;
  45.         InitDialogs(nil);
  46.         InitCursor;
  47.         FlushEvents(everyEvent, 0);
  48.     end; {InitStuff}
  49.  
  50.  
  51.     procedure ZoomRect (zoomLarger: Boolean; var smallRect: Rect; var bigRect: Rect);
  52.         var
  53.             firstStep, stepValue, trailer, zoomRatio: double;
  54.             i, step: Integer;
  55.             curRect: Rect;
  56.             ticks: LongInt;
  57.         procedure CalcRect (var theRect: Rect; var smallRect: Rect; var bigRect: Rect; stepValue: double);
  58.         begin
  59.             theRect.left := smallRect.left + Trunc((bigRect.left - smallRect.left) * stepValue);
  60.             theRect.top := smallRect.top + Trunc((bigRect.top - smallRect.top) * stepValue);
  61.             theRect.right := smallRect.right + Trunc((bigRect.right - smallRect.right) * stepValue);
  62.             theRect.bottom := smallRect.bottom + Trunc((bigRect.bottom - smallRect.bottom) * stepValue);
  63.         end; {CalcRect}
  64.     begin
  65. {$IFC UNDEFINED THINK_PASCAL}
  66.         PenPat(qd.gray);
  67. {$ELSEC}
  68.         PenPat(gray);
  69. {$ENDC}
  70.         PenMode(patXor);
  71.  
  72.         firstStep := kZoomRatio;
  73.         for i := 0 to kNumSteps - 1 do
  74.             begin
  75.                 firstStep := firstStep * kZoomRatio;
  76.             end;
  77.  
  78.         if not zoomLarger then
  79.             begin
  80.                 zoomRatio := 1.0 / kZoomRatio;
  81.                 firstStep := 1.0 - firstStep;
  82.             end
  83.         else
  84.             zoomRatio := kZoomRatio;
  85.  
  86.         trailer := firstStep;
  87.         stepValue := firstStep;
  88.         for step := 0 to kNumSteps + kRectsVisible - 1 do
  89.         { draw new frame}
  90.             begin
  91.                 if step < kNumSteps then
  92.                     begin
  93.                         stepValue := stepValue / zoomRatio;
  94.                         CalcRect(curRect, smallRect, bigRect, stepValue);
  95.                         FrameRect(curRect);
  96.                     end;
  97.  
  98.         { erase old frame}
  99.  
  100.                 if (step >= kRectsVisible) then
  101.                     begin
  102.                         trailer := trailer / zoomRatio;
  103.                         CalcRect(curRect, smallRect, bigRect, trailer);
  104.                         FrameRect(curRect);
  105.                     end;
  106.  
  107.                 Delay(kDelayTicks, ticks);
  108.             end;
  109.  
  110.         PenNormal;
  111.     end; {ZoomRect}
  112.  
  113.  
  114.     function GetRects (var zoomFrom: Rect; var zoomTo: Rect): Boolean;
  115.         var
  116.             numRects: Integer;
  117.             ev: EventRecord;
  118.             theRect, drawRect: Rect;
  119.             firstPt, curPt, oldPt, globalPt: Point;
  120.             theKeys: KeyMap;
  121.             window: WindowPtr;
  122.         procedure FixRect (var theRect: Rect; var rightRect: Rect);
  123.         begin
  124.             if (theRect.right > theRect.left) then
  125.                 begin
  126.                     rightRect.right := theRect.right;
  127.                     rightRect.left := theRect.left;
  128.                 end
  129.             else
  130.                 begin
  131.                     rightRect.right := theRect.left;
  132.                     rightRect.left := theRect.right;
  133.                 end;
  134.  
  135.             if (theRect.bottom > theRect.top) then
  136.                 begin
  137.                     rightRect.bottom := theRect.bottom;
  138.                     rightRect.top := theRect.top;
  139.                 end
  140.             else
  141.                 begin
  142.                     rightRect.bottom := theRect.top;
  143.                     rightRect.top := theRect.bottom;
  144.                 end;
  145.         end; {FixRect}
  146.     begin
  147.         numRects := 0;
  148.         PenMode(patXor);
  149.  
  150.         repeat
  151.             while not Button do
  152.                 ;
  153.  
  154.             GetMouse(globalPt);
  155.             LocalToGlobal(globalPt);
  156.             if (FindWindow(globalPt, window) = inGoAway) and (window = FrontWindow) then
  157.                 begin
  158.                     gDone := true;
  159.                     GetRects := false;
  160.                 end;
  161.  
  162.             GetMouse(firstPt);
  163.             oldPt := firstPt;
  164.             SetRect(theRect, firstPt.h, firstPt.v, firstPt.h, firstPt.v);
  165.             while Button do
  166.                 begin
  167.                     GetMouse(curPt);
  168.                     if (not EqualPt(curPt, oldPt)) then
  169.                         begin
  170.                             FixRect(theRect, drawRect);
  171.                             FrameRect(drawRect);
  172.                             oldPt := curPt;
  173.                             theRect.right := curPt.h;
  174.                             theRect.bottom := curPt.v;
  175.                             FixRect(theRect, drawRect);
  176.                             FrameRect(drawRect);
  177.                         end;
  178.                 end;
  179.  
  180.             FixRect(theRect, drawRect);
  181.             if numRects = 0 then
  182.                 zoomFrom := drawRect
  183.             else
  184.                 zoomTo := drawRect;
  185.  
  186.             numRects := numRects + 1;
  187.  
  188.         until not (numRects < 2);
  189.  
  190.         PenNormal;
  191.     end; {GetRects}
  192.  
  193. {main}
  194.     var
  195.         window: WindowPtr;
  196.         bounds, zoomFrom, zoomTo: Rect;
  197.  
  198. begin
  199.     InitStuff;
  200.     bounds := screenBits.bounds;
  201.     bounds.top := 40;
  202.     InsetRect(bounds, 20, 20);
  203. {SetRect(bounds, 12, 44, 500, 330);}
  204.     window := NewWindow(nil, bounds, 'Drag Two Rects to Zoom', true, documentProc, WindowPtr(-1), true, 0);
  205.     SetPort(window);
  206.  
  207.     repeat
  208.         if GetRects(zoomFrom, zoomTo) then
  209.             ZoomRect(kZoomLarger, zoomFrom, zoomTo);
  210.         EraseRect(window^.portRect);
  211.     until gDone;
  212.     FlushEvents(everyEvent, 0);
  213. end.